home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / aegis.t < prev    next >
Text File  |  1988-05-02  |  2KB  |  74 lines
  1. (herald aegis (env tsys))
  2.  
  3. ;;;; T/AEGIS interface
  4.  
  5. ;;; Operating System Descriptor
  6.  
  7. (define local-os
  8.   (lambda ()
  9.     (object nil
  10.       ((os-type self)               'aegis)
  11.       ((aegis-os? self)             '#t)
  12.       ((print-type-string self)     "Operating-system"))))
  13.  
  14.  
  15. ;;; Command line hacking
  16.  
  17. (define-foreign pgm_$get_args
  18.   ("PGM_$GET_ARGS" (out    rep/integer-16-u argument-count)
  19.                  (ignore rep/integer      arg-vector-addr))
  20.                 ignore)
  21.  
  22. (define-foreign pgm_$get_arg
  23.   ("PGM_$GET_ARG" (in     rep/integer-16-u   arg-number)
  24.                 (ignore rep/extend         argument)
  25.                 (out    rep/integer        status)
  26.                 (in     rep/integer-16-u   maxlen))
  27.       rep/integer-16-u)
  28.  
  29. (define (argc)
  30.   (pgm_$get_args nil nil))
  31.  
  32. (define (aegis-get-arg n)
  33.   (with-buffers ((buf))
  34.     (receive (length status)
  35.              (pgm_$get_arg n
  36.                            (buffer-text buf)
  37.                            nil
  38.                            (max-buffer-length buf))
  39.       (cond ((fx= 0 status)
  40.              (set (buffer-length buf) length)
  41.              (buffer->string buf))
  42.             (else (local-os-error status))))))
  43.  
  44. (define (command-line)
  45.   (do ((i (fx- (argc) 1) (fx- i 1))
  46.        (l '() (cons (aegis-get-arg i) l)))
  47.       ((fx< i 0) l)))
  48.  
  49.  
  50. ;;; Names of standard places to find things
  51.  
  52. ;;; The T-SYSTEM-DIRECTORY is the place where the various files 
  53. ;;; (possibily) needed to startup the system are found, e.g.
  54. ;;; the image file, the fix file(s), the configuration file ...
  55.  
  56. (define (the-t-system-directory)
  57.   'tsystem)
  58.  
  59. ;;; The INIT-FILE-DIRECTORY is the directory in which the user's
  60. ;;; initialization file should be located.
  61.  
  62. (define (the-init-file-directory) "~")
  63.  
  64. ;;; LUSER-TYPED-EOF-AT-TOP-LEVEL is a system dependent exception
  65. ;;; which occurs when the REPL gets an EOF.
  66.  
  67. (define (luser-typed-eof-at-top-level . args)
  68.   (ignore args)
  69.   (format (error-output) "** use (exit) to exit.~%"))
  70.  
  71. ;;; Initialize the local OS.
  72.  
  73. (define (initialize-local-system) nil)
  74.